home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-main.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-02-18  |  19.7 KB  |  830 lines
  1. /*  $Id: pl-main.c,v 1.65 1998/02/18 13:57:03 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: Prologs main module
  8. */
  9.  
  10. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  11. Get the ball rolling.  The main task of  this  module  is  command  line
  12. option  parsing,  initialisation  and  handling  of errors and warnings.
  13. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  14.  
  15. /*#define O_DEBUG 1*/
  16.  
  17. #include "pl-incl.h"
  18. #include "pl-save.h"
  19. #include "pl-ctype.h"
  20. #ifdef HAVE_SYS_PARAM_H
  21. #include <sys/param.h>
  22. #endif
  23.  
  24. forwards void    usage(void);
  25. static void    version(void);
  26. static void    arch(void);
  27. static void    runtime_vars(void);
  28. static bool    vsysError(const char *fm, va_list args);
  29.  
  30. #define    optionString(s) { if (argc > 1) \
  31.               { s = argv[1]; argc--; argv++; \
  32.               } else \
  33.                 usage(); \
  34.             }
  35. #define K * 1024L
  36.  
  37. #define EXECVARMAGIC "$EXECVARS="
  38. static const char exec_vars[512] = EXECVARMAGIC;
  39.  
  40. static const char *
  41. exec_var(const char *name)
  42. { const char *s=exec_vars + strlen(EXECVARMAGIC);
  43.   int l = strlen(name);
  44.  
  45.   while(s < exec_vars+sizeof(exec_vars))
  46.   { if ( strncmp(name, s, l) == 0 && s[l] == '=' )
  47.       return &s[l+1];
  48.     while(*s && s< exec_vars+sizeof(exec_vars))
  49.       s++;
  50.     while(*s == '\0' && s< exec_vars+sizeof(exec_vars))
  51.       s++;
  52.   }
  53.  
  54.   return NULL;
  55. }
  56.  
  57.  
  58. static char *
  59. findHome(char *symbols)
  60. { char *home = NULL;
  61.   char envbuf[MAXPATHLEN];
  62.   char plp[MAXPATHLEN];
  63.   const char *val = exec_var("homevar");
  64.   
  65.   if ( (val  = exec_var("homevar")) &&
  66.        (home = getenv3(val, envbuf, sizeof(envbuf))) &&
  67.        (home = PrologPath(home, plp)) )
  68.     return store_string(home);
  69.   if ( (val = exec_var("home")) &&
  70.        (home = PrologPath(home, plp)) )
  71.     return store_string(home);
  72.  
  73.   if ( !(home = getenv3("SWI_HOME_DIR", envbuf, sizeof(envbuf))) )
  74.     home = getenv3("SWIPL", envbuf, sizeof(envbuf));
  75.   if ( home && (home = PrologPath(home, plp)) && ExistsDirectory(home) )
  76.     return store_string(home);
  77.  
  78.   if ( (home = symbols) )
  79.   { char buf[MAXPATHLEN];
  80.     char parent[MAXPATHLEN];
  81.     IOSTREAM *fd;
  82.  
  83.     strcpy(parent, DirName(DirName(AbsoluteFile(home, buf), buf), buf));
  84.     Ssprintf(buf, "%s/swipl", parent);
  85.  
  86.     if ( (fd = Sopen_file(buf, "r")) )
  87.     { if ( Sfgets(buf, sizeof(buf), fd) )
  88.       { int l = strlen(buf);
  89.  
  90.     while(l > 0 && buf[l-1] <= ' ')
  91.       l--;
  92.     buf[l] = EOS;
  93.  
  94. #if O_XOS
  95.       { char buf2[MAXPATHLEN];
  96.     _xos_canonical_filename(buf, buf2);
  97.     strcpy(buf, buf2);
  98.       }
  99. #endif
  100.  
  101.     if ( !IsAbsolutePath(buf) )
  102.     { char buf2[MAXPATHLEN];
  103.  
  104.       Ssprintf(buf2, "%s/%s", parent, buf);
  105.       home = AbsoluteFile(buf2, plp);
  106.     } else
  107.       home = AbsoluteFile(buf, plp);
  108.  
  109.     if ( ExistsDirectory(home) )
  110.     { Sclose(fd);
  111.       return store_string(home);
  112.     }
  113.       }
  114.       Sclose(fd);
  115.     }
  116.   }
  117.  
  118.   if ( (home = PrologPath(PLHOME, plp)) &&
  119.        ExistsDirectory(home) )
  120.     return store_string(home);
  121.  
  122. #if tos || __DOS__ || __WINDOWS__
  123. #if tos
  124. #define HasDrive(c) (Drvmap() & (1 << (c - 'a')))
  125. #else
  126. #define HasDrive(c) 1
  127. #endif
  128.   { char *drv;
  129.     static char drvs[] = "cdefghijklmnopab";
  130.     char home[MAXPATHLEN];
  131.  
  132.     for(drv = drvs; *drv; drv++)
  133.     { Ssprintf(home, "/%c:/pl", *drv);
  134.       if ( HasDrive(*drv) && ExistsDirectory(home) )
  135.         return store_string(home);
  136.     }
  137.   }
  138. #endif
  139.  
  140.   return NULL;
  141. }
  142.  
  143. /*
  144.   -- atoenne -- convert state to an absolute path. This allows relative
  145.   SWI_HOME_DIR and cleans up non-canonical paths.
  146. */
  147.  
  148. #ifndef IS_DIR_SEPARATOR
  149. #define IS_DIR_SEPARATOR(c) ((c) == '/')
  150. #endif
  151.  
  152. static char *
  153. proposeStartupFile(char *symbols)
  154. { char state[MAXPATHLEN];
  155.   char buf[MAXPATHLEN];
  156.  
  157.   if ( !symbols && (symbols = Symbols(state)) )
  158.     symbols = DeRefLink(symbols, buf);
  159.  
  160.   if ( symbols )
  161.   { char *s, *dot = NULL;
  162.  
  163.     strcpy(state, symbols);
  164.     for(s=state; *s; s++)
  165.     { if ( *s == '.' )
  166.     dot = s;
  167.       if ( IS_DIR_SEPARATOR(*s) )
  168.     dot = NULL;
  169.     }
  170.     if ( dot )
  171.       *dot = EOS;
  172.  
  173.     strcat(state, ".qlf");
  174.  
  175.     return store_string(state);
  176.   }
  177.  
  178.   if ( systemDefaults.home )
  179.   { Ssprintf(state, "%s/startup/startup.%s",
  180.          systemDefaults.home, systemDefaults.arch);
  181.     return store_string(AbsoluteFile(state, buf));
  182.   } else
  183.     return store_string("pl.qlf");
  184. }
  185.  
  186.  
  187. static char *
  188. findState(char *symbols)
  189. { char state[MAXPATHLEN];
  190.   char *full;
  191.  
  192.   full = proposeStartupFile(symbols);
  193.   if ( AccessFile(full, ACCESS_READ) )
  194.     return full;
  195.  
  196.   if ( systemDefaults.home )
  197.   { char tmp[MAXPATHLEN];
  198.  
  199.     Ssprintf(state, "%s/startup/startup.%s",
  200.          systemDefaults.home, systemDefaults.arch);
  201.     if ( AccessFile(state, ACCESS_READ) )
  202.       return store_string(AbsoluteFile(state, tmp));
  203.  
  204.     Ssprintf(state, "%s/startup/startup", systemDefaults.home);
  205.     if ( AccessFile(state, ACCESS_READ) )
  206.       return store_string(AbsoluteFile(state, tmp));
  207.   }
  208.  
  209.   return NULL;
  210. }
  211.  
  212.  
  213. #ifndef O_RUNTIME
  214. static void
  215. warnNoFile(char *file)
  216. { AccessFile(file, ACCESS_READ);    /* just to set errno */
  217.  
  218.   Sfprintf(Serror, "    no `%s': %s\n", file, OsError());
  219. }
  220. #endif
  221.  
  222. static void
  223. warnNoState()
  224. {
  225. #ifdef O_RUNTIME
  226.   Sfprintf(Serror, "[FATAL ERROR: Runtime system: can not find a state to run\n");
  227.   Sfprintf(Serror, "\tUsage: %s -x state\n", GD->cmdline.argv[0]);
  228.   Sfprintf(Serror, "\t\twhere <state> is created using qsave_program/[1,2]\n");
  229.   Sfprintf(Serror, "\t\tin the development system]\n");
  230. #else
  231.   char state[MAXPATHLEN];
  232.   char *full;
  233.  
  234.   Sfprintf(Serror, "[FATAL ERROR: Failed to find startup file\n");
  235.   full = proposeStartupFile(NULL);
  236.   if ( full )
  237.     warnNoFile(full);
  238.   if ( systemDefaults.home )
  239.   { char tmp[MAXPATHLEN];
  240.     Ssprintf(state, "%s/startup/startup.%s",
  241.          systemDefaults.home, systemDefaults.arch);
  242.     warnNoFile(AbsoluteFile(state, tmp));
  243.  
  244.     Ssprintf(state, "%s/startup/startup", systemDefaults.home);
  245.     warnNoFile(AbsoluteFile(state, tmp));
  246.   } else
  247.     Sfprintf(Serror, "    No home directory!\n");
  248.  
  249.   Sfprintf(Serror,
  250.       "\nUse\n\t`%s -O -o startup-file -b boot/init.pl'\n",
  251.       GD->cmdline.argv[0]);
  252.   Sfprintf(Serror, "\nto create one]\n");
  253. #endif
  254.  
  255.   Halt(1);
  256. }
  257.  
  258. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  259. The default name of the system init file `base.rc' is determined from the
  260. basename of the running program, taking all the leading alnum characters.
  261. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  262.  
  263. static char *
  264. defaultSystemInitFile(char *a0)
  265. { char plp[MAXPATHLEN];
  266.   char *base = BaseName(PrologPath(a0, plp));
  267.   char buf[256];
  268.   char *s = buf;
  269.  
  270.   while(*base && isAlpha(*base))
  271.     *s++ = *base++;
  272.   *s = EOS;
  273.  
  274.   if ( strlen(buf) > 0 )
  275.     return store_string(buf);
  276.  
  277.   return "pl";
  278. }
  279.  
  280.  
  281. #define MEMAREA_INVALID_SIZE (unsigned long)(~0L)
  282.  
  283. static unsigned long
  284. memarea_limit(const char *s)
  285. { number n;
  286.   unsigned char *q;
  287.  
  288.   if ( get_number((unsigned char *)s, &q, &n) && intNumber(&n) )
  289.   { switch((int)*q)
  290.     { case 'k':
  291.       case 'K':
  292.       case EOS:
  293.     return n.value.i K;
  294.       case 'm':
  295.       case 'M':
  296.     return n.value.i K K;
  297.       case 'b':
  298.       case 'B':
  299.     return n.value.i;
  300.     }
  301.   }
  302.  
  303.   return MEMAREA_INVALID_SIZE;
  304. }
  305.  
  306.  
  307. #if O_LINK_PCE
  308. foreign_t
  309. pl_pce_init()
  310. { prolog_pce_init(GD->cmdline.argc, GD->cmdline.argv);
  311.  
  312.   succeed;
  313. }
  314. #endif
  315.  
  316. int
  317. startProlog(int argc, char **argv)
  318. { char *s;
  319.   int n;
  320.   char *state = NULL, *symbols = NULL;
  321.   bool compile;
  322.   bool explicit_state = FALSE;
  323.   bool explicit_compile_out = FALSE;
  324.   int loadflags = QLF_TOPLEVEL;
  325.  
  326.   GD->cmdline.argc = argc;
  327.   GD->cmdline.argv = argv;
  328.  
  329.   DEBUG(1, Sdprintf("System compiled at %s %s\n", __TIME__, __DATE__));
  330.  
  331. #if O_MALLOC_DEBUG
  332.   malloc_debug(O_MALLOC_DEBUG);
  333. #endif
  334.  
  335.   GD->debug_level = 0;
  336.   DEBUG(1, Sdprintf("OS ...\n"));
  337.   initOs();                /* initialise OS bindings */
  338.  
  339.   if ( GD->dumped == FALSE )
  340.   { char plp[MAXPATHLEN];
  341.  
  342.     if ( (symbols = Symbols(plp)) &&
  343.      (symbols = DeRefLink(symbols, plp)) )
  344.       symbols = store_string(symbols);
  345.     else
  346.       symbols = argv[0];        /* may not be fatal */
  347.  
  348.     systemDefaults.arch        = ARCH;
  349.     systemDefaults.home           = findHome(symbols);
  350.  
  351. #ifdef O_XOS
  352.     if ( systemDefaults.home )
  353.     { char buf[MAXPATHLEN];
  354.       _xos_limited_os_filename(systemDefaults.home, buf);
  355.       systemDefaults.home = store_string(buf);
  356.     }
  357. #endif
  358.  
  359.     systemDefaults.startup     = store_string(PrologPath(DEFSTARTUP, plp));
  360.     systemDefaults.local       = DEFLOCAL;
  361.     systemDefaults.global      = DEFGLOBAL;
  362.     systemDefaults.trail       = DEFTRAIL;
  363.     systemDefaults.argument    = DEFARGUMENT;
  364.     systemDefaults.heap           = DEFHEAP;
  365.     systemDefaults.goal           = "'$welcome'";
  366.     systemDefaults.toplevel    = "prolog";
  367. #ifndef NOTTYCONTROL
  368. #define NOTTYCONTROL FALSE
  369. #endif
  370.     systemDefaults.notty       = NOTTYCONTROL;
  371.   } else
  372.   { DEBUG(1, Sdprintf("Restarting from dumped state\n"));
  373.   }
  374.  
  375.   compile            = FALSE;
  376.   GD->io_initialised        = FALSE;
  377.   GD->initialised        = FALSE;
  378.   GD->cmdline.notty        = systemDefaults.notty;
  379.   GD->bootsession        = FALSE;
  380.   LD->autoload            = TRUE;
  381.  
  382.   argc--; argv++;
  383.  
  384.                     /* EMACS inferior processes */
  385.                     /* PceEmacs inferior processes */
  386. { char envbuf[4];
  387.  
  388.   if ( ((s = getenv3("EMACS", envbuf, sizeof(envbuf))) && streq(s, "t")) ||
  389.        ((s = getenv3("INFERIOR", envbuf, sizeof(envbuf))) && streq(s, "yes")) )
  390.     GD->cmdline.notty = TRUE;
  391. }
  392.  
  393.   for(n=0; n<argc; n++)            /* need to check this first */
  394.   { DEBUG(2, Sdprintf("argv[%d] = %s\n", n, argv[n]));
  395.     if (streq(argv[n], "-b") )
  396.       GD->bootsession = TRUE;
  397.   }
  398.  
  399.   DEBUG(1, {if (GD->bootsession) Sdprintf("Boot session\n");});
  400.  
  401.   if ( argc >= 2 && streq(argv[0], "-r") )
  402.   { char tmp[MAXPATHLEN];
  403.     loaderstatus.restored_state = lookupAtom(AbsoluteFile(argv[1], tmp));
  404.     argc -= 2, argv += 2;        /* recover; we've done this! */
  405.   }
  406.  
  407.   if ( argc >= 2 && streq(argv[0], "-x") )
  408.   { state = argv[1];
  409.     argc -= 2, argv += 2;
  410.     explicit_state = TRUE;
  411.     DEBUG(1, Sdprintf("Startup file = %s\n", state));
  412. #ifdef ASSOCIATE_STATE
  413.   } else if ( argc == 1 && stripostfix(argv[0], ASSOCIATE_STATE) )
  414.   { state = argv[0];
  415.     argc--, argv++;
  416.     explicit_state = TRUE;
  417.     DEBUG(1, Sdprintf("Startup file = %s\n", state));
  418. #endif /*ASSOCIATE_STATE*/
  419.   }
  420.   
  421.   if ( argc >= 1 )
  422.   { if ( streq(argv[0], "-help") )
  423.       usage();
  424.     if ( streq(argv[0], "-arch") )
  425.       arch();
  426.     if ( streq(argv[0], "-v") )
  427.       version();
  428.     if ( streq(argv[0], "-dump-runtime-variables") )
  429.       runtime_vars();
  430.   }
  431.  
  432.   GD->options.systemInitFile = defaultSystemInitFile(GD->cmdline.argv[0]);
  433.  
  434.   if ( !GD->bootsession && GD->dumped == FALSE )
  435.   { int state_loaded = FALSE;
  436.  
  437.     if ( !explicit_state )
  438.     { if ( loadWicFile(symbols, loadflags|QLF_OPTIONS|QLF_EXESTATE) == TRUE )
  439.       { systemDefaults.state = state = symbols;
  440.     state_loaded++;
  441.     loadflags |= QLF_EXESTATE;
  442.       } else
  443.       { systemDefaults.state = state = findState(symbols);
  444.     if ( state == NULL )
  445.       warnNoState();
  446.       }
  447.     }
  448.  
  449.     if ( !state_loaded && loadWicFile(state, loadflags|QLF_OPTIONS) != TRUE )
  450.       Halt(1);
  451.  
  452.     DEBUG(2, Sdprintf("options.localSize    = %ld\n", GD->options.localSize));
  453.     DEBUG(2, Sdprintf("options.globalSize   = %ld\n", GD->options.globalSize));
  454.     DEBUG(2, Sdprintf("options.trailSize    = %ld\n", GD->options.trailSize));
  455.     DEBUG(2, Sdprintf("options.argumentSize = %ld\n", GD->options.argumentSize));
  456.     DEBUG(2, Sdprintf("options.goal         = %s\n",  GD->options.goal));
  457.     DEBUG(2, Sdprintf("options.topLevel     = %s\n",  GD->options.topLevel));
  458.     DEBUG(2, Sdprintf("options.initFile     = %s\n",  GD->options.initFile));
  459.   } else
  460.   { if ( !explicit_state )
  461.       systemDefaults.state = state = findState(symbols);
  462.  
  463.     GD->options.compileOut      = "a.out";
  464.     GD->options.localSize      = systemDefaults.local    K;
  465.     GD->options.globalSize      = systemDefaults.global   K;
  466.     GD->options.trailSize      = systemDefaults.trail    K;
  467.     GD->options.argumentSize  = systemDefaults.argument K;
  468.     GD->options.heapSize      = systemDefaults.heap        K;
  469.     GD->options.goal      = systemDefaults.goal;
  470.     GD->options.topLevel      = systemDefaults.toplevel;
  471.     GD->options.initFile      = systemDefaults.startup;
  472.   }
  473.  
  474.   for( ; argc > 0 && (argv[0][0] == '-' || argv[0][0] == '+'); argc--, argv++ )
  475.   { if ( streq(&argv[0][1], "tty") )
  476.     { GD->cmdline.notty = (argv[0][0] == '-');
  477.       continue;
  478.     }
  479.     if ( streq(&argv[0][1], "-" ) )    /* pl <plargs> -- <app-args> */
  480.       break;
  481.  
  482.     s = &argv[0][1];
  483.     while(*s)
  484.     { switch(*s)
  485.       { case 'd':    if (argc > 1)
  486.             { GD->debug_level = atoi(argv[1]);
  487.               argc--, argv++;
  488.             } else
  489.               usage();
  490.             break;
  491.     case 'p':    if (!argc)    /* handled in Prolog */
  492.               usage();
  493.             argc--, argv++;
  494.             break;
  495.     case 'O':    GD->cmdline.optimise = TRUE;
  496.             break;
  497.       case 'o':    optionString(GD->options.compileOut);
  498.             explicit_compile_out = TRUE;
  499.             break;
  500.     case 'f':    optionString(GD->options.initFile);
  501.             break;
  502.     case 'F':    optionString(GD->options.systemInitFile);
  503.             break;
  504.     case 'g':    optionString(GD->options.goal);
  505.             break;
  506.     case 't':    optionString(GD->options.topLevel);
  507.             break;
  508.     case 'c':    compile = TRUE;
  509.             break;
  510.     case 'b':    GD->bootsession = TRUE;
  511.             break;
  512.     case 'B':
  513. #if !O_DYNAMIC_STACKS
  514.             GD->options.localSize    = 32 K;
  515.             GD->options.globalSize   = 8 K;
  516.             GD->options.trailSize    = 8 K;
  517.             GD->options.argumentSize = 1 K;
  518. #endif
  519.             goto next;
  520.     case 'L':
  521.     case 'G':
  522.     case 'T':
  523.     case 'A':
  524.     case 'H':
  525.         { unsigned long size = memarea_limit(&s[1]);
  526.       
  527.       if ( size == MEMAREA_INVALID_SIZE )
  528.         usage();
  529.  
  530.       switch(*s)
  531.       { case 'L':    GD->options.localSize    = size; goto next;
  532.         case 'G':    GD->options.globalSize   = size; goto next;
  533.         case 'T':    GD->options.trailSize    = size; goto next;
  534.         case 'A':    GD->options.argumentSize = size; goto next;
  535.         case 'H':    GD->options.heapSize     = size; goto next;
  536.       }
  537.     }
  538.       }
  539.       s++;
  540.     }
  541.     next:;
  542.   }
  543. #undef K
  544.   
  545.   DEBUG(1, Sdprintf("Command line options parsed\n"));
  546.  
  547.   setupProlog();
  548.   initialiseForeign(argc, argv);    /* PL_initialise_hook() functions */
  549.  
  550.   systemMode(TRUE);
  551.  
  552.   if ( GD->bootsession )
  553.   { if ( !explicit_compile_out )
  554.       GD->options.compileOut = proposeStartupFile(NULL);
  555.  
  556.     LD->autoload = FALSE;
  557.     if ( compileFileList(GD->options.compileOut, argc, argv) == TRUE )
  558.     {
  559. #if defined(__WINDOWS__) || defined(__WIN32__)
  560.       PlMessage("Boot compilation has created %s", GD->options.compileOut);
  561. #else
  562.       if ( !explicit_compile_out )
  563.     Sfprintf(Serror, "Result stored in %s\n", GD->options.compileOut);
  564. #endif
  565.       Halt(0);
  566.     }
  567.  
  568.     Halt(1);
  569.   }
  570.  
  571.   if ( state != NULL )
  572.   { GD->bootsession = TRUE;
  573.     if ( loadWicFile(state, loadflags) != TRUE )
  574.       Halt(1);
  575.     GD->bootsession = FALSE;
  576.     CSetFeature("boot_file", state);
  577.   }
  578.  
  579.   debugstatus.styleCheck = (LONGATOM_CHECK|
  580.                 SINGLETON_CHECK|
  581.                 DISCONTIGUOUS_STYLE);
  582.   systemMode(FALSE);
  583.   GD->dumped = TRUE;
  584.   GD->initialised = TRUE;
  585.  
  586. #if O_LINK_PCE
  587.   PL_register_foreign("$pce_init", 0, pl_pce_init, PL_FA_TRANSPARENT, 0);
  588. #endif
  589.  
  590.   DEBUG(1, Sdprintf("Starting Prolog Engine\n"));
  591.  
  592.   if ( compile )
  593.   { Halt(prolog(lookupAtom("$compile")) ? 0 : 1);
  594.   }
  595.     
  596.   return prolog(lookupAtom("$initialise"));
  597. }
  598.  
  599. typedef const char *cline;
  600.  
  601. static void
  602. usage()
  603. { static const cline lines[] = {
  604.     "%s: Usage:\n",
  605.     "    1) %s -help      Display this message\n",
  606.     "    2) %s -v         Display version information\n",
  607.     "    3) %s -arch      Display architecture\n",
  608.     "    4) %s -dump-runtime-variables\n"
  609.     "                     Dump link info in sh(1) format\n",
  610.     "    5) %s [options]\n",
  611.     "    6) %s [options] [-o output] -c file ...\n",
  612.     "    7) %s [options] [-o output] -b bootfile -c file ...\n",
  613.     "Options:\n",
  614.     "    -x state         Start from state (must be first)\n",
  615.     "    -[LGTAH]size[KM] Specify {Local,Global,Trail,Argument,Heap} limits\n",
  616.     "    -B               Small stack sizes to prepare for boot\n",
  617.     "    -t toplevel      Toplevel goal\n",
  618.     "    -g goal          Initialisation goal\n",
  619.     "    -f file          Initialisation file\n",
  620.     "    -F file          System Initialisation file\n",
  621.     "    [+/-]tty         Allow tty control\n",
  622.     "    -O               Optimised compilation\n",
  623.     NULL
  624.   };
  625.   const cline *lp = lines;
  626.  
  627.   for(lp = lines; *lp; lp++)
  628.     Sfprintf(Serror, *lp, BaseName(GD->cmdline.argv[0]));
  629.  
  630.   Halt(1);
  631. }
  632.  
  633. static void
  634. version()
  635. { Sprintf("SWI-Prolog version %d.%d.%d for %s\n",
  636.       PLVERSION / 10000,
  637.       (PLVERSION / 100) % 100,
  638.       PLVERSION % 100,
  639.       ARCH);
  640.  
  641.   Halt(0);
  642. }
  643.  
  644.  
  645. static void
  646. arch()
  647. { Sprintf("%s\n", ARCH);
  648.  
  649.   Halt(0);
  650. }
  651.  
  652.  
  653. static void
  654. runtime_vars()
  655. { Sprintf("CC=\"%s\";\n"
  656.       "PLBASE=\"%s\";\n"
  657.       "PLARCH=\"%s\";\n"
  658.       "PLLIBS=\"%s\";\n"
  659.       "PLLDFLAGS=\"%s\";\n"
  660.       "PLVERSION=\"%d\";\n"
  661. #if defined(HAVE_DLOPEN) || defined(HAVE_SHL_LOAD)
  662.       "PLSHARED=\"yes\";\n",
  663. #else
  664.       "PLSHARED=\"no\";\n",
  665. #endif
  666.       C_CC,
  667.       systemDefaults.home ? systemDefaults.home : "<no home>",
  668.       ARCH,
  669.       C_LIBS,
  670.       C_LDFLAGS,
  671.       PLVERSION);
  672.  
  673.   Halt(0);
  674. }
  675.  
  676. #include <stdarg.h>
  677.  
  678. bool
  679. sysError(const char *fm, ...)
  680. { va_list args;
  681.  
  682.   va_start(args, fm);
  683.   vsysError(fm, args);
  684.   va_end(args);
  685.  
  686.   PL_fail;
  687. }
  688.  
  689.  
  690. bool
  691. fatalError(const char *fm, ...)
  692. { va_list args;
  693.  
  694.   va_start(args, fm);
  695.   vfatalError(fm, args);
  696.   va_end(args);
  697.  
  698.   PL_fail;
  699. }
  700.  
  701.  
  702. bool
  703. warning(const char *fm, ...)
  704. { va_list args;
  705.  
  706.   va_start(args, fm);
  707.   vwarning(fm, args);
  708.   va_end(args);
  709.  
  710.   PL_fail;
  711. }
  712.  
  713.  
  714. static bool
  715. vsysError(const char *fm, va_list args)
  716. { Sfprintf(Serror, "[PROLOG INTERNAL ERROR:\n\t");
  717.   Svfprintf(Serror, fm, args);
  718.   if ( gc_status.active )
  719.   { Sfprintf(Serror,
  720.         "\n[While in %ld-th garbage collection; skipping stacktrace]\n",
  721.         gc_status.collections);
  722.   }
  723.   if ( GD->bootsession || !GD->initialised )
  724.   { Sfprintf(Serror,
  725.          "\n[While initialising; quitting]\n");
  726.     Halt(1);
  727.   }
  728.  
  729. #if defined(O_DEBUGGER)
  730.   if ( !gc_status.active )
  731.   { Sfprintf(Serror, "\n[Switched to system mode: style_check(+dollar)]\n");
  732.     debugstatus.styleCheck |= DOLLAR_STYLE;
  733.     Sfprintf(Serror, "PROLOG STACK:\n");
  734.     backTrace(NULL, 10);
  735.     Sfprintf(Serror, "]\n");
  736.   }
  737. #endif /*O_DEBUGGER*/
  738.  
  739. action:
  740.   Sprintf("\nAction? "); Sflush(Soutput);
  741.   ResetTty();
  742.   switch(getSingleChar())
  743.   { case 'a':
  744.       pl_abort();
  745.       break;
  746.     case 'e':
  747.       Halt(3);
  748.       break;
  749.     default:
  750.       Sprintf("Unknown action.  Valid actions are:\n"
  751.           "\ta\tabort to toplevel\n"
  752.           "\te\texit Prolog\n");
  753.       goto action;
  754.   }
  755.  
  756.   pl_abort();
  757.   Halt(3);
  758.   PL_fail;
  759. }
  760.  
  761.  
  762. bool
  763. vfatalError(const char *fm, va_list args)
  764. {
  765. #if defined(__WINDOWS__) || defined(__WIN32__)
  766.   char msg[500];
  767.   Ssprintf(msg, "[FATAL ERROR:\n\t");
  768.   Svsprintf(&msg[strlen(msg)], fm, args);
  769.   Ssprintf(&msg[strlen(msg)], "]");
  770.   
  771.   PlMessage(msg);
  772. #else
  773.   Sfprintf(Serror, "[FATAL ERROR:\n\t");
  774.   Svfprintf(Serror, fm, args);
  775.   Sfprintf(Serror, "]\n");
  776. #endif
  777.  
  778.   Halt(2);
  779.   PL_fail;
  780. }
  781.  
  782.  
  783. bool
  784. vwarning(const char *fm, va_list args)
  785. { toldString();
  786.  
  787.   if ( trueFeature(REPORT_ERROR_FEATURE) )
  788.   { if ( ReadingSource &&
  789.      !GD->bootsession && GD->initialised &&
  790.      !LD->outofstack )        /* cannot call Prolog */
  791.     { fid_t cid = PL_open_foreign_frame();
  792.       term_t argv = PL_new_term_refs(3);
  793.       predicate_t pred = PL_pred(FUNCTOR_exception3, MODULE_user);
  794.       term_t a = PL_new_term_ref();
  795.       char message[LINESIZ];
  796.       qid_t qid;
  797.       int rval;
  798.   
  799.       Svsprintf(message, fm, args);
  800.   
  801.       PL_put_atom(   argv+0, ATOM_warning);
  802.       PL_put_functor(argv+1, FUNCTOR_warning3);
  803.       PL_get_arg(1, argv+1, a); PL_unify_atom(a, source_file_name);
  804.       PL_get_arg(2, argv+1, a); PL_unify_integer(a, source_line_no);
  805.       PL_get_arg(3, argv+1, a); PL_unify_string_chars(a, message);
  806.       
  807.       qid = PL_open_query(MODULE_user, PL_Q_NODEBUG, pred, argv);
  808.       rval = PL_next_solution(qid);
  809.       PL_close_query(qid);
  810.       PL_discard_foreign_frame(cid);
  811.   
  812.       if ( !rval )
  813.       { Sfprintf(Serror, "[WARNING: (%s:%d)\n\t%s]\n",
  814.          stringAtom(source_file_name), source_line_no, message);
  815.       }
  816.   
  817.       PL_fail;                /* handled */
  818.     }
  819.   
  820.     Sfprintf(Serror, "[WARNING: ");
  821.     Svfprintf(Serror, fm, args);
  822.     Sfprintf(Serror, "]\n");
  823.   }
  824.  
  825.   if ( trueFeature(DEBUG_ON_ERROR_FEATURE) )
  826.     pl_trace();
  827.  
  828.   PL_fail;
  829. }
  830.